unit uProject ;

interface

uses
    Types,
    Classes,
    Graphics,
    Forms,
    Menus,
    Controls,
    ActnList,
    Dialogs,
    Inifiles,
    TB2MRU,
    TBXExtItems,
    TntDialogs,
    VirtualTrees,
    uBasic,
    uObjects,
    GDIPOBJ,
    GDIPAPI,
    TB2Item,
    TBX,
    SpTBXItem,
    TB2ExtItems,
    SpTBXEditors,
    ExtCtrls,
    uMouseHandler,
    uVisitor,
    uViewSchematic,
    uViewPCB
    ;

type

    TPopupVisitor = class( TMedaVisitor )
    private
    public
        // viewers
        function VisitNode( Instance : TMedaPCBLayer ) : TObject ; override ;
        function VisitNode( Instance : TMedaPCBInterface ) : TObject ; override ;
        function VisitNode( Instance : TMedaSchematicPage ) : TObject ; override ;
        function VisitNode( Instance : TMedaSchInterface ) : TObject ; override ;

        function VisitNode( Instance : TMedaObject ) : TObject ; override ;
        function VisitNode( Instance : TMedaVisible ) : TObject ; override ;
        function VisitNode( Instance : TMedaContainer ) : TObject ; override ;
        function VisitNode( Instance : TMedaVisibleContainer ) : TObject ; override ;
        function VisitNode( Instance : TMedaPart ) : TObject ; override ;
        function VisitNode( Instance : TMedaBank ) : TObject ; override ;
        function VisitNode( Instance : TMedaPin ) : TObject ; override ;
        function VisitNode( Instance : TMedaLabel ) : TObject ; override ;
        function VisitNode( Instance : TMedaPower ) : TObject ; override ;
        function VisitNode( Instance : TMedaPort ) : TObject ; override ;
        function VisitNode( Instance : TMedaNet ) : TObject ; override ;
        function VisitNode( Instance : TMedaLine ) : TObject ; override ;
        function VisitNode( Instance : TMedaTrack ) : TObject ; override ;
        function VisitNode( Instance : TMedaVia ) : TObject ; override ;
        function VisitNode( Instance : TMedaCopper ) : TObject ; override ;
        function VisitNode( Instance : TMedaShape ) : TObject ; override ;
        function VisitNode( Instance : TMedaStack ) : TObject ; override ;
        function VisitNode( Instance : TMedaModule ) : TObject ; override ;
        function VisitNode( Instance : TMedaProject ) : TObject ; override ;
    end ;

    TdmProject = class( TDataModule )
        ActionList : TActionList ;
        actNew : TAction ;
        actOpen : TAction ;
        actSave : TAction ;
        actSaveAs : TAction ;
        actExit : TAction ;
        OpenDialog : TTntOpenDialog ;
        SaveDialog : TTntSaveDialog ;
        actView : TAction ;
        MRUList : TTBXMRUList ;
        actTest : TAction ;
        actSort : TAction ;
        actZoomIn : TAction ;
        actZoomOut : TAction ;
        actXilinxCSV : TAction ;
        pumPin : TSpTBXPopupMenu ;
        pumPart : TSpTBXPopupMenu ;
        pumBank : TSpTBXPopupMenu ;
        pumLine : TSpTBXPopupMenu ;
        pumNet : TSpTBXPopupMenu ;
        pumTrack : TSpTBXPopupMenu ;
        pumVia : TSpTBXPopupMenu ;
        pumShape : TSpTBXPopupMenu ;
        pumProject : TSpTBXPopupMenu ;
        pumModule : TSpTBXPopupMenu ;
        pumStack : TSpTBXPopupMenu ;
        pumCopper : TSpTBXPopupMenu ;
        SpTBXItem1 : TSpTBXItem ;
        SpTBXSeparatorItem1 : TSpTBXSeparatorItem ;
        SpTBXItem2 : TSpTBXItem ;
        SpTBXItem3 : TSpTBXItem ;
        SpTBXSeparatorItem2 : TSpTBXSeparatorItem ;
        SpTBXItem5 : TSpTBXItem ;
        SpTBXSeparatorItem3 : TSpTBXSeparatorItem ;
        SpTBXItem6 : TSpTBXItem ;
        actAddShape : TAction ;
        actAddModule : TAction ;
        actDelModule : TAction ;
        actImportEcPinPakBank : TAction ;
        actPlaceBank : TAction ;
        SpTBXItem7 : TSpTBXItem ;
        SpTBXItem8 : TSpTBXItem ;
        SpTBXItem9 : TSpTBXItem ;
        actLinkPin : TAction ;
        actPlaceShape : TAction ;
        SpTBXItem12 : TSpTBXItem ;
        SpTBXSeparatorItem5 : TSpTBXSeparatorItem ;
        SpTBXItem13 : TSpTBXItem ;
        SpTBXItem14 : TSpTBXItem ;
        SpTBXSeparatorItem6 : TSpTBXSeparatorItem ;
        SpTBXItem15 : TSpTBXItem ;
        SpTBXItem10 : TSpTBXItem ;
        SpTBXItem11 : TSpTBXItem ;
        actLinkStack : TAction ;
        SpTBXItem16 : TSpTBXItem ;
        actShowObject : TAction ;
        SpTBXItem17 : TSpTBXItem ;
        actUnPlaceBank : TAction ;
        SpTBXItem18 : TSpTBXItem ;
        SpTBXSeparatorItem8 : TSpTBXSeparatorItem ;
        SpTBXItem19 : TSpTBXItem ;
        SpTBXItem20 : TSpTBXItem ;
        actUnplaceShape : TAction ;
        XilinxOpenDialog : TOpenDialog ;
        SpTBXItem21 : TSpTBXItem ;
        actDelPart : TAction ;
        SpTBXItem22 : TSpTBXItem ;
        actDelShape : TAction ;
        actSelectTool : TAction ;
        actDrawTool : TAction ;
        actDragTool : TAction ;
        actConnectTool : TAction ;
        actCutTool : TAction ;
        actCopyTool : TAction ;
        actPasteTool : TAction ;
        pumPCB : TSpTBXPopupMenu ;
        pumPage : TSpTBXPopupMenu ;
        pumSchematic : TSpTBXPopupMenu ;
        pumLayer : TSpTBXPopupMenu ;
        SpTBXItem23 : TSpTBXItem ;
        SpTBXSeparatorItem9 : TSpTBXSeparatorItem ;
        SpTBXItem24 : TSpTBXItem ;
        SpTBXItem25 : TSpTBXItem ;
        SpTBXItem26 : TSpTBXItem ;
        SpTBXSeparatorItem10 : TSpTBXSeparatorItem ;
        actImportPerfEDA : TAction ;
        pumLabel : TSpTBXPopupMenu ;
        SpTBXItem27 : TSpTBXItem ;
        SpTBXSeparatorItem11 : TSpTBXSeparatorItem ;
        SpTBXItem28 : TSpTBXItem ;
        SpTBXItem29 : TSpTBXItem ;
        SpTBXItem30 : TSpTBXItem ;
        actAddSubModule : TAction ;
        actCreateBank : TAction ;
        pumPort : TSpTBXPopupMenu ;
        SpTBXItem33 : TSpTBXItem ;
        SpTBXSeparatorItem12 : TSpTBXSeparatorItem ;
        SpTBXItem34 : TSpTBXItem ;
        SpTBXItem35 : TSpTBXItem ;
        SpTBXSeparatorItem13 : TSpTBXSeparatorItem ;
        SpTBXItem36 : TSpTBXItem ;
        SpTBXItem37 : TSpTBXItem ;
        SpTBXSeparatorItem14 : TSpTBXSeparatorItem ;
        SpTBXItem38 : TSpTBXItem ;
        SpTBXItem39 : TSpTBXItem ;
        actRotateBank : TAction ;
        SpTBXSeparatorItem15 : TSpTBXSeparatorItem ;
        SpTBXItem40 : TSpTBXItem ;
        actMirrorBank : TAction ;
        PEOpenDialog : TTntOpenDialog ;
        LibraryOpenDialog : TTntOpenDialog ;
        actDeleteLine : TAction ;
        SpTBXItem41 : TSpTBXItem ;
        SpTBXItem42 : TSpTBXItem ;
        SpTBXSeparatorItem16 : TSpTBXSeparatorItem ;
        actDelBank : TAction ;
        SpTBXSeparatorItem17 : TSpTBXSeparatorItem ;
        SpTBXItem43 : TSpTBXItem ;
        SpTBXSeparatorItem18 : TSpTBXSeparatorItem ;
        SpTBXItem44 : TSpTBXItem ;
        actMirrorShape : TAction ;
        actRotateShape : TAction ;
        SpTBXItem45 : TSpTBXItem ;
        SpTBXItem46 : TSpTBXItem ;
        SpTBXItem47 : TSpTBXItem ;
        actAddPart : TAction ;
        SpTBXSeparatorItem19 : TSpTBXSeparatorItem ;
        actAddBank : TAction ;
        SpTBXSeparatorItem20 : TSpTBXSeparatorItem ;
        SpTBXItem31 : TSpTBXItem ;
        actDeleteNet : TAction ;
        SpTBXItem32 : TSpTBXItem ;
        SpTBXItem48 : TSpTBXItem ;
        SpTBXSeparatorItem21 : TSpTBXSeparatorItem ;
        SpTBXItem49 : TSpTBXItem ;
        SpTBXItem50 : TSpTBXItem ;
        SpTBXItem51 : TSpTBXItem ;
        SpTBXItem52 : TSpTBXItem ;
        SpTBXItem53 : TSpTBXItem ;
        SpTBXItem54 : TSpTBXItem ;
        SpTBXItem55 : TSpTBXItem ;
        SpTBXSeparatorItem22 : TSpTBXSeparatorItem ;
        SpTBXItem56 : TSpTBXItem ;
        SpTBXItem57 : TSpTBXItem ;
        SpTBXItem59 : TSpTBXItem ;
        SpTBXItem60 : TSpTBXItem ;
        SpTBXSeparatorItem23 : TSpTBXSeparatorItem ;
        SpTBXItem58 : TSpTBXItem ;
        SpTBXSeparatorItem24 : TSpTBXSeparatorItem ;
        SpTBXItem61 : TSpTBXItem ;
        SpTBXItem62 : TSpTBXItem ;
        actDeletePort : TAction ;
        actAddPort : TAction ;
        SpTBXItem64 : TSpTBXItem ;
        SpTBXItem63 : TSpTBXItem ;
        SpTBXSeparatorItem25 : TSpTBXSeparatorItem ;
        SpTBXItem65 : TSpTBXItem ;
        actSavePart : TAction ;
        LibrarySaveDialog : TTntSaveDialog ;
        actSaveModule : TAction ;
        SpTBXSeparatorItem26 : TSpTBXSeparatorItem ;
        SpTBXItem66 : TSpTBXItem ;
        SpTBXItem4 : TSpTBXItem ;
        SpTBXItem67 : TSpTBXItem ;
        actSaveBank : TAction ;
        actSaveShape : TAction ;
        SpTBXItem68 : TSpTBXItem ;
        SpTBXSeparatorItem27 : TSpTBXSeparatorItem ;
        SpTBXSeparatorItem28 : TSpTBXSeparatorItem ;
        actDeleteStack : TAction ;
        actSaveStack : TAction ;
        SpTBXSeparatorItem4 : TSpTBXSeparatorItem ;
        SpTBXItem69 : TSpTBXItem ;
        SpTBXItem70 : TSpTBXItem ;
        procedure DataModuleCreate( Sender : TObject ) ;
        procedure DataModuleDestroy( Sender : TObject ) ;
        procedure actExitExecute( Sender : TObject ) ;
        procedure actOpenExecute( Sender : TObject ) ;
        procedure actNewExecute( Sender : TObject ) ;
        procedure actSaveExecute( Sender : TObject ) ;
        procedure actSaveUpdate( Sender : TObject ) ;
        procedure actSaveAsExecute( Sender : TObject ) ;
        procedure actTestExecute( Sender : TObject ) ;
        procedure actSortExecute( Sender : TObject ) ;
        procedure actXilinxCSVExecute( Sender : TObject ) ;
        procedure actAddShapeExecute( Sender : TObject ) ;
        procedure actDelModuleExecute( Sender : TObject ) ;
        procedure actAddModuleExecute( Sender : TObject ) ;
        procedure actImportEcPinPakBankExecute( Sender : TObject ) ;
        procedure actImportEcPinPakBankUpdate( Sender : TObject ) ;
        procedure actDelModuleUpdate( Sender : TObject ) ;
        procedure actLinkPinExecute( Sender : TObject ) ;
        procedure actLinkPinUpdate( Sender : TObject ) ;
        procedure actShowObjectExecute( Sender : TObject ) ;
        procedure actPlaceBankExecute( Sender : TObject ) ;
        procedure actPlaceBankUpdate( Sender : TObject ) ;
        procedure actPlaceShapeExecute( Sender : TObject ) ;
        procedure actPlaceShapeUpdate( Sender : TObject ) ;
        procedure actUnPlaceBankExecute( Sender : TObject ) ;
        procedure actUnPlaceBankUpdate( Sender : TObject ) ;
        procedure actUnplaceShapeExecute( Sender : TObject ) ;
        procedure actUnplaceShapeUpdate( Sender : TObject ) ;
        procedure actAddShapeUpdate( Sender : TObject ) ;
        procedure actLinkStackExecute( Sender : TObject ) ;
        procedure actLinkStackUpdate( Sender : TObject ) ;
        procedure actDelPartExecute( Sender : TObject ) ;
        procedure actDelPartUpdate( Sender : TObject ) ;
        procedure actDelShapeExecute( Sender : TObject ) ;
        procedure actDelShapeUpdate( Sender : TObject ) ;
        procedure actSelectToolExecute( Sender : TObject ) ;
        procedure actDrawToolExecute( Sender : TObject ) ;
        procedure actDragToolExecute( Sender : TObject ) ;
        procedure actConnectToolExecute( Sender : TObject ) ;
        procedure actSelectToolUpdate( Sender : TObject ) ;
        procedure actDrawToolUpdate( Sender : TObject ) ;
        procedure actDragToolUpdate( Sender : TObject ) ;
        procedure actConnectToolUpdate( Sender : TObject ) ;
        procedure ActionListUpdate( Action : TBasicAction ; var Handled : Boolean ) ;
        procedure MRUListClick( Sender : TObject ; const Filename : string ) ;
        procedure actImportPerfEDAExecute( Sender : TObject ) ;
        procedure actImportPerfEDAUpdate( Sender : TObject ) ;
        procedure actAddSubModuleExecute( Sender : TObject ) ;
        procedure actCreateBankExecute( Sender : TObject ) ;
        procedure actRotateBankExecute( Sender : TObject ) ;
        procedure actRotateBankUpdate( Sender : TObject ) ;
        procedure actMirrorBankExecute( Sender : TObject ) ;
        procedure actMirrorBankUpdate( Sender : TObject ) ;
        procedure actDeleteLineExecute( Sender : TObject ) ;
        procedure actDeleteLineUpdate( Sender : TObject ) ;
        procedure actDelBankExecute( Sender : TObject ) ;
        procedure actDelBankUpdate( Sender : TObject ) ;
        procedure actRotateShapeExecute( Sender : TObject ) ;
        procedure actRotateShapeUpdate( Sender : TObject ) ;
        procedure actMirrorShapeExecute( Sender : TObject ) ;
        procedure actMirrorShapeUpdate( Sender : TObject ) ;
        procedure actAddSubModuleUpdate( Sender : TObject ) ;
        procedure actAddModuleUpdate( Sender : TObject ) ;
        procedure actCreateBankUpdate( Sender : TObject ) ;
        procedure actShowObjectUpdate( Sender : TObject ) ;
        procedure actAddPartExecute( Sender : TObject ) ;
        procedure actAddPartUpdate( Sender : TObject ) ;
        procedure actAddBankExecute( Sender : TObject ) ;
        procedure actAddBankUpdate( Sender : TObject ) ;
        procedure actDeleteNetExecute( Sender : TObject ) ;
        procedure actDeleteNetUpdate( Sender : TObject ) ;
        procedure actDeletePortExecute( Sender : TObject ) ;
        procedure actDeletePortUpdate( Sender : TObject ) ;
        procedure actAddPortExecute( Sender : TObject ) ;
        procedure actAddPortUpdate( Sender : TObject ) ;
        procedure actSavePartExecute( Sender : TObject ) ;
        procedure actSavePartUpdate( Sender : TObject ) ;
        procedure actSaveModuleExecute( Sender : TObject ) ;
        procedure actSaveModuleUpdate( Sender : TObject ) ;
        procedure actSaveBankExecute( Sender : TObject ) ;
        procedure actSaveBankUpdate( Sender : TObject ) ;
        procedure actSaveShapeExecute( Sender : TObject ) ;
        procedure actSaveShapeUpdate( Sender : TObject ) ;
        procedure actDeleteStackExecute( Sender : TObject ) ;
        procedure actDeleteStackUpdate( Sender : TObject ) ;
        procedure actSaveStackExecute( Sender : TObject ) ;
        procedure actSaveStackUpdate( Sender : TObject ) ;
    private
        { Private declarations }
        fProject : TMedaProject ;
        fTool : TMedaTool ;
        fProjTree : TFrame ;
        fXML : TFrame ;
        fNeedsUpdate : boolean ;

        procedure Clear ;
        procedure SetTool( const Value : TMedaTool ) ;
    public
        { Public declarations }
        property Project : TMedaProject read fProject ;
        property Tool : TMedaTool read FTool write SetTool ;
        procedure RegisterTree( aTreeForm : TFrame ) ;

        function CreateMouseHandler( aMouseFactory : TMouseFactory ; Shift : TShiftState ; aGrid : integer ) : TMouseHandler ;

        function GetPopup( aObject : TMedaObject ) : TPopupMenu ;
        function SelectedObject : TMedaObject ;
        procedure UnselectObject ;

        procedure Update ;
        function UpdateFile : boolean ;
        procedure Test ;
    end ;

var
    dmProject       : TdmProject ;

implementation

uses
    uMain,
    SysUtils,
    uXML,
    uXilinxCSV,
    uPerfEDA,
    uAppData,
    dgAddPort,
    fmProjSett,
    fmProjTree ;

{$R *.dfm}

{ TPopupVisitor }

function TPopupVisitor.VisitNode( Instance : TMedaVisible ) : TObject ;
begin
    Result := nil ;
end ;

function TPopupVisitor.VisitNode( Instance : TMedaObject ) : TObject ;
begin
    Result := nil ;
end ;

function TPopupVisitor.VisitNode( Instance : TMedaVisibleContainer ) : TObject ;
begin
    Result := nil ;
end ;

function TPopupVisitor.VisitNode( Instance : TMedaContainer ) : TObject ;
begin
    Result := nil ;
end ;

function TPopupVisitor.VisitNode( Instance : TMedaPin ) : TObject ;
begin
    Result := dmProject.pumPin ;
end ;

function TPopupVisitor.VisitNode( Instance : TMedaLabel ) : TObject ;
begin
    Result := dmProject.pumLabel ;
end ;

function TPopupVisitor.VisitNode( Instance : TMedaPower ) : TObject ;
begin
    Result := dmProject.pumLabel ;
end ;

function TPopupVisitor.VisitNode( Instance : TMedaBank ) : TObject ;
begin
    Result := dmProject.pumBank ;
end ;

function TPopupVisitor.VisitNode( Instance : TMedaLine ) : TObject ;
begin
    Result := dmProject.pumLine ;
end ;

function TPopupVisitor.VisitNode( Instance : TMedaNet ) : TObject ;
begin
    Result := dmProject.pumNet ;
end ;

function TPopupVisitor.VisitNode( Instance : TMedaPort ) : TObject ;
begin
    Result := dmProject.pumPort ;
end ;

function TPopupVisitor.VisitNode( Instance : TMedaModule ) : TObject ;
begin
    Result := dmProject.pumModule ;
end ;

function TPopupVisitor.VisitNode( Instance : TMedaPart ) : TObject ;
begin
    Result := dmProject.pumPart ;
end ;

function TPopupVisitor.VisitNode( Instance : TMedaStack ) : TObject ;
begin
    Result := dmProject.pumStack ;
end ;

function TPopupVisitor.VisitNode( Instance : TMedaVia ) : TObject ;
begin
    Result := dmProject.pumVia ;
end ;

function TPopupVisitor.VisitNode( Instance : TMedaTrack ) : TObject ;
begin
    Result := dmProject.pumTrack ;
end ;

function TPopupVisitor.VisitNode( Instance : TMedaShape ) : TObject ;
begin
    Result := dmProject.pumShape ;
end ;

function TPopupVisitor.VisitNode( Instance : TMedaCopper ) : TObject ;
begin
    Result := dmProject.pumCopper ;
end ;

function TPopupVisitor.VisitNode( Instance : TMedaProject ) : TObject ;
begin
    Result := dmProject.pumProject ;
end ;

function TPopupVisitor.VisitNode( Instance : TMedaPCBInterface ) : TObject ;
begin
    Result := dmProject.pumPCB ;
end ;

function TPopupVisitor.VisitNode( Instance : TMedaPCBLayer ) : TObject ;
begin
    Result := dmProject.pumLayer ;
end ;

function TPopupVisitor.VisitNode( Instance : TMedaSchInterface ) : TObject ;
begin
    Result := dmProject.pumSchematic ;
end ;

function TPopupVisitor.VisitNode( Instance : TMedaSchematicPage ) : TObject ;
begin
    Result := dmProject.pumPage ;
end ;

{ TdmProject }

procedure TdmProject.actExitExecute( Sender : TObject ) ;
begin
    frmMain.Close ;
end ;

procedure TdmProject.actNewExecute( Sender : TObject ) ;
begin
    UpdateFile ;
    dmProject.Clear ;
end ;

procedure TdmProject.MRUListClick( Sender : TObject ; const Filename : string ) ;
begin
    dmProject.Clear ;
    Project.Filename := Filename ;
    Project.LoadFromFile ;
end ;

procedure TdmProject.actOpenExecute( Sender : TObject ) ;
begin
    UpdateFile ;
    if assigned( fXML ) then
        with OpenDialog do begin
            Filename := Project.Filename ;
            if Execute then begin
                MRUList.Add( Filename ) ;
                dmProject.Clear ;
                Project.Filename := Filename ;
                ( fXML as TfrmXML ).LoadProject( Project, Filename ) ;
            end ;
        end ;
end ;

procedure TdmProject.actImportPerfEDAExecute( Sender : TObject ) ;
begin
    UpdateFile ;
    with PEOpenDialog do begin
        Filename := Project.Filename ;
        if Execute then begin
            MRUList.Add( Filename ) ;
            dmProject.Clear ;
            Project.Filename := ChangeFileExt( Filename, '.mtx' ) ;
            dmPerfEDA.BuildProject( Project, Filename ) ;
        end ;
    end ;
end ;

procedure TdmProject.actImportPerfEDAUpdate( Sender : TObject ) ;
begin
    ( Sender as TAction ).Enabled := assigned( Project ) ;
end ;

procedure TdmProject.actSaveExecute( Sender : TObject ) ;
begin
    if ( Project.Filename = '' ) or ( lowercase( Project.Filename ) = 'untitled' ) then
        actSaveAsExecute( Sender )
    else
        Project.SaveToFile ;
end ;

procedure TdmProject.actSaveUpdate( Sender : TObject ) ;
begin
    ( Sender as TAction ).Enabled := assigned( Project ) and Project.Stale ;
end ;

procedure TdmProject.actSaveAsExecute( Sender : TObject ) ;
begin
    with SaveDialog do begin
        Filename := Project.Filename ;
        if Execute then begin
            MRUList.Add( Filename ) ;
            Project.Filename := Filename ;
            Project.SaveToFile ;
        end ;
    end ;
end ;

function TdmProject.UpdateFile : boolean ;
begin
    Result := True ;
    if not Project.Stale then
        Exit ;
    case MessageDlg( 'Save current project?', mtConfirmation, [ mbYes, mbNo, mbCancel ], 0 ) of
        mrYes : actSaveExecute( nil ) ;
        mrNo : ;
        mrCancel : Result := False ;
    end ;
end ;

procedure TdmProject.ActionListUpdate( Action : TBasicAction ; var Handled : Boolean ) ;
begin
    if fNeedsUpdate then begin
        ( fProjTree as TfrmProjTree ).UpdateTree( True ) ;
        frmMain.frmPCBTree.UpdateTree( True ) ;
        frmMain.frmSchematicTree.UpdateTree( True ) ;
        fNeedsUpdate := False ;
    end ;
end ;

procedure TdmProject.Update ;
begin
    fNeedsUpdate := True ;
end ;

procedure TdmProject.Clear ;
begin
    if assigned( fProjTree ) then
        ( fProjTree as TfrmProjTree ).Clear ;
    if assigned( Project ) then
        Project.Clear ;
    vsbPCBViewer.Clear ;
    vsbSchematicViewer.Clear ;
    Update ;
end ;

procedure TdmProject.actDelModuleExecute( Sender : TObject ) ;
begin
    if MessageDlg( Format( 'Really delete module: "%s" and its contents?', [ SelectedObject.Name ] ), mtConfirmation, mbOKCancel, 0 ) = mrOK then begin
        ( SelectedObject as TMedaModule ).Unplace ;
        ( SelectedObject as TMedaModule ).Vaporize ;
        Update ;
    end ;
    UnselectObject ;
end ;

procedure TdmProject.actDelModuleUpdate( Sender : TObject ) ;
begin
    ( Sender as TAction ).Enabled := ( SelectedObject <> nil ) and ( SelectedObject is TMedaModule ) ;
end ;

procedure TdmProject.actAddModuleExecute( Sender : TObject ) ;
var
    s               : string ;
    iModule         : TMedaModule ;
begin
    with Project do
        if InputQuery( 'Add Module', 'Enter module name', s ) then begin
            iModule := NewModule ;
            iModule.Name := s ;
            Log.Formatted( 'Module: %s added', [ s ] ) ;
            Update ;
        end ;
end ;

procedure TdmProject.actAddModuleUpdate( Sender : TObject ) ;
begin
    ( Sender as TAction ).Enabled := assigned( Project ) ;
end ;

procedure TdmProject.actAddSubModuleExecute( Sender : TObject ) ;
var
    s               : string ;
    iModule         : TMedaModule ;
begin
    with TMedaModule( SelectedObject ) do
        if InputQuery( 'Add Module', 'Enter module name', s ) then begin
            iModule := AddModule ;
            iModule.Name := s ;
            Log.Formatted( 'Submodule: %s added', [ s ] ) ;
            Update ;
        end ;
    UnselectObject ;
end ;

procedure TdmProject.actAddSubModuleUpdate( Sender : TObject ) ;
begin
    ( Sender as TAction ).Enabled := ( SelectedObject <> nil ) and ( SelectedObject is TMedaModule ) ;
end ;

procedure TdmProject.actCreateBankExecute( Sender : TObject ) ;
begin
    TMedaModule( SelectedObject ).BuildBank ;
    UnselectObject ;
end ;

procedure TdmProject.actCreateBankUpdate( Sender : TObject ) ;
begin
    ( Sender as TAction ).Enabled := ( SelectedObject <> nil ) and ( SelectedObject is TMedaModule ) ;
end ;

procedure TdmProject.actShowObjectExecute( Sender : TObject ) ;
begin
    SelectedObject.Show ;
    UnselectObject ;
end ;

procedure TdmProject.actShowObjectUpdate( Sender : TObject ) ;
begin
    ( Sender as TAction ).Enabled := ( SelectedObject <> nil ) ;
end ;

procedure TdmProject.actLinkPinExecute( Sender : TObject ) ;
var
    iPort           : TMedaPort ;
    iStack          : TMedaStack ;
begin
    if ( SelectedObject <> nil ) and ( SelectedObject is TMedaPin ) then begin
        iPort := TMedaPin( SelectedObject ).Port ;
        if assigned( iPort ) then begin
            iStack := iPort.Stack ;
            if assigned( iStack ) then
                iStack.Show ;
        end ;
    end ;
    if ( SelectedObject <> nil ) then
        SelectedObject.SetSelection( False ) ;
    UnselectObject ;
end ;

procedure TdmProject.actLinkPinUpdate( Sender : TObject ) ;
begin
    ( Sender as TAction ).Enabled :=
        ( SelectedObject <> nil ) and
        ( SelectedObject is TMedaPin ) and
        assigned( TMedaPin( SelectedObject ).Port ) and
        assigned( TMedaPin( SelectedObject ).Port.Stack ) ;
end ;

procedure TdmProject.actLinkStackExecute( Sender : TObject ) ;
var
    iPort           : TMedaPort ;
    iPin            : TMedaPin ;
begin
    if ( SelectedObject <> nil ) and ( SelectedObject is TMedaStack ) then begin
        iPort := TMedaStack( SelectedObject ).Port ;
        if assigned( iPort ) then begin
            iPin := iPort.Pin ;
            if assigned( iPin ) then
                iPin.Show ;
        end ;
    end ;
    if ( SelectedObject <> nil ) then
        SelectedObject.SetSelection( False ) ;
    UnselectObject ;
end ;

procedure TdmProject.actLinkStackUpdate( Sender : TObject ) ;
begin
    ( Sender as TAction ).Enabled := ( SelectedObject <> nil ) and
        ( SelectedObject is TMedaStack ) and
        assigned( TMedaStack( SelectedObject ).Port ) and
        assigned( TMedaStack( SelectedObject ).Port.Pin ) ;
end ;

procedure TdmProject.actDeleteStackExecute( Sender : TObject ) ;
begin
    if MessageDlg( Format( 'Really delete stack: "%s"?', [ SelectedObject.Name ] ), mtConfirmation, mbOKCancel, 0 ) = mrOK then begin
        ( SelectedObject as TMedaStack ).UnPlace ;
        ( SelectedObject as TMedaStack ).Vaporize ;
        Update ;
    end ;
    UnselectObject ;
end ;

procedure TdmProject.actDeleteStackUpdate( Sender : TObject ) ;
begin
    ( Sender as TAction ).Enabled := ( SelectedObject <> nil ) and
        ( SelectedObject is TMedaStack ) ;
end ;

procedure TdmProject.actSaveStackExecute( Sender : TObject ) ;
begin
    with LibrarySaveDialog do begin
        InitialDir := GetLibPath + 'Stacks\' ;
        Filter := 'MTX Stack files (*.xml)|*.xml|All files (*.*)|*.*' ;
        DefaultExt := 'xml' ;
        Title := 'Save Stack ' + SelectedObject.Designator + ' As' ;
        Filename := SelectedObject.Name + '.xml' ;
        if Execute then
            ( fXML as TfrmXML ).SaveToFile( SelectedObject, Filename ) ;
        UnselectObject ;
    end ;
end ;

procedure TdmProject.actSaveStackUpdate( Sender : TObject ) ;
begin
    ( Sender as TAction ).Enabled := ( SelectedObject <> nil ) and
        ( SelectedObject is TMedaStack ) ;
end ;

procedure TdmProject.actAddBankExecute( Sender : TObject ) ;
var
    aBank           : TMedaBank ;
begin
    with LibraryOpenDialog do begin
        InitialDir := GetLibPath + 'Banks\' ;
        Filter := 'MTX library files (*.xml)|*.xml|All files (*.*)|*.*' ;
        DefaultExt := 'xml' ;
        Title := 'Add Footprint' ;
        if Execute then begin
            aBank := ( SelectedObject as TMedaPart ).AddBank ;
            aBank.Build( Filename ) ;
            Update ;
        end ;
    end ;
    UnselectObject ;
end ;

procedure TdmProject.actAddBankUpdate( Sender : TObject ) ;
begin
    ( Sender as TAction ).Enabled := ( SelectedObject <> nil ) and
        ( SelectedObject is TMedaPart ) ;
end ;

procedure TdmProject.actAddShapeExecute( Sender : TObject ) ;
var
    aShape          : TMedaShape ;
begin
    with LibraryOpenDialog do begin
        InitialDir := GetLibPath + 'Footprints\' ;
        Filter := 'MTX library files (*.xml)|*.xml|All files (*.*)|*.*' ;
        DefaultExt := 'xml' ;
        Title := 'Add Footprint' ;
        if Execute then begin
            aShape := ( SelectedObject as TMedaPart ).AddShape ;
            aShape.Build( Filename ) ;
            Update ;
        end ;
    end ;
    UnselectObject ;
end ;

procedure TdmProject.actAddShapeUpdate( Sender : TObject ) ;
begin
    ( Sender as TAction ).Enabled := ( SelectedObject <> nil ) and
        ( SelectedObject is TMedaPart ) ;
end ;

procedure TdmProject.actAddPartExecute( Sender : TObject ) ;
begin
    with LibraryOpenDialog do begin
        InitialDir := GetLibPath + 'Parts\' ;
        Filter := 'MTX library files (*.xml)|*.xml|All files (*.*)|*.*' ;
        DefaultExt := 'xml' ;
        Title := 'Add Part' ;
        if Execute then begin
            ( fXML as TfrmXML ).LoadFromFile( SelectedObject as TMedaModule, Filename ) ;
            Update ;
        end ;
    end ;
    UnselectObject ;
end ;

procedure TdmProject.actAddPartUpdate( Sender : TObject ) ;
begin
    ( Sender as TAction ).Enabled := ( SelectedObject <> nil ) and
        ( SelectedObject is TMedaModule ) ;
end ;

procedure TdmProject.actImportEcPinPakBankExecute( Sender : TObject ) ;
begin
    with LibraryOpenDialog do begin
        InitialDir := GetLibPath + 'ECPinPak\' ;
        Filter := 'ECPinPak Bank files (*.xml)|*.xml|All files (*.*)|*.*' ;
        DefaultExt := 'xml' ;
        Title := 'Import ECPinPak Bank' ;
        if Execute then begin
            ( fXML as TfrmXML ).ImportECPinPakBank( SelectedObject as TMedaPart, Filename ) ;
            Update ;
        end ;
    end ;
    UnselectObject ;
end ;

procedure TdmProject.actImportEcPinPakBankUpdate( Sender : TObject ) ;
begin
    ( Sender as TAction ).Enabled := ( SelectedObject <> nil ) and
        ( SelectedObject is TMedaPart ) ;
end ;

procedure TdmProject.actSavePartExecute( Sender : TObject ) ;
begin
    with LibrarySaveDialog do begin
        InitialDir := GetLibPath + 'Parts\' ;
        Filter := 'MTX Part files (*.xml)|*.xml|All files (*.*)|*.*' ;
        DefaultExt := 'xml' ;
        Title := 'Save Part ' + SelectedObject.Designator + ' As' ;
        Filename := SelectedObject.Name + '.xml' ;
        if Execute then
            ( fXML as TfrmXML ).SaveToFile( SelectedObject, Filename ) ;
        UnselectObject ;
    end ;
end ;

procedure TdmProject.actSavePartUpdate( Sender : TObject ) ;
begin
    ( Sender as TAction ).Enabled := ( SelectedObject <> nil ) and
        ( SelectedObject is TMedaPart ) ;
end ;

procedure TdmProject.actSaveModuleExecute( Sender : TObject ) ;
begin
    with LibrarySaveDialog do begin
        InitialDir := GetLibPath + 'Modules\' ;
        Filter := 'MTX Module files (*.xml)|*.xml|All files (*.*)|*.*' ;
        DefaultExt := 'xml' ;
        Title := 'Save Module ' + SelectedObject.Designator + ' As' ;
        Filename := SelectedObject.Name + '.xml' ;
        if Execute then
            ( fXML as TfrmXML ).SaveToFile( SelectedObject, Filename ) ;
        UnselectObject ;
    end ;
end ;

procedure TdmProject.actSaveModuleUpdate( Sender : TObject ) ;
begin
    ( Sender as TAction ).Enabled := ( SelectedObject <> nil ) and
        ( SelectedObject is TMedaModule ) ;
end ;

procedure TdmProject.actDelPartExecute( Sender : TObject ) ;
begin
    if MessageDlg( Format( 'Really delete part: "%s"?', [ SelectedObject.Name ] ), mtConfirmation, mbOKCancel, 0 ) = mrOK then begin
        ( SelectedObject as TMedaPart ).UnPlace ;
        ( SelectedObject as TMedaPart ).Vaporize ;
        Update ;
    end ;
    UnselectObject ;
end ;

procedure TdmProject.actDelPartUpdate( Sender : TObject ) ;
begin
    ( Sender as TAction ).Enabled := ( SelectedObject <> nil ) and
        ( SelectedObject is TMedaPart ) ;
end ;

procedure TdmProject.actSaveBankExecute( Sender : TObject ) ;
begin
    with LibrarySaveDialog do begin
        InitialDir := GetLibPath + 'Banks\' ;
        Filter := 'MTX Bank files (*.xml)|*.xml|All files (*.*)|*.*' ;
        DefaultExt := 'xml' ;
        Title := 'Save Bank ' + SelectedObject.Designator + ' As' ;
        Filename := SelectedObject.Name + '.xml' ;
        if Execute then
            ( fXML as TfrmXML ).SaveToFile( SelectedObject, Filename ) ;
        UnselectObject ;
    end ;
end ;

procedure TdmProject.actSaveBankUpdate( Sender : TObject ) ;
begin
    ( Sender as TAction ).Enabled :=
        ( SelectedObject <> nil ) and ( SelectedObject is TMedaBank ) ;
end ;

procedure TdmProject.actPlaceBankExecute( Sender : TObject ) ;
var
    iTrans          : TMedaTransform ;
begin
    iTrans.Position := MakePoint( 200.0, 200.0 ) ;
    iTrans.Rotation := drEast ;
    iTrans.Mirror := False ;
    TMedaBank( SelectedObject ).Place( vsbSchematicViewer.Pages[ vsbSchematicViewer.CurrentPageIndex ], iTrans ) ;
    Update ;
    UnselectObject ;
end ;

procedure TdmProject.actPlaceBankUpdate( Sender : TObject ) ;
begin
    ( Sender as TAction ).Enabled :=
        ( SelectedObject <> nil ) and ( SelectedObject is TMedaBank ) and
        ( vsbSchematicViewer.CanPlace ) and ( not SelectedObject.IsPlaced ) ;
end ;

procedure TdmProject.actRotateBankExecute( Sender : TObject ) ;
begin
    TMedaBank( SelectedObject ).Rotate ;
    Update ;
    UnselectObject ;
end ;

procedure TdmProject.actRotateBankUpdate( Sender : TObject ) ;
begin
    ( Sender as TAction ).Enabled :=
        ( SelectedObject <> nil ) and ( SelectedObject is TMedaBank ) and
        ( SelectedObject.IsPlaced ) ;
end ;

procedure TdmProject.actMirrorBankExecute( Sender : TObject ) ;
begin
    TMedaBank( SelectedObject ).Mirrorize ;
    Update ;
    UnselectObject ;
end ;

procedure TdmProject.actMirrorBankUpdate( Sender : TObject ) ;
begin
    ( Sender as TAction ).Enabled :=
        ( SelectedObject <> nil ) and ( SelectedObject is TMedaBank ) and
        ( SelectedObject.IsPlaced ) ;
end ;

procedure TdmProject.actRotateShapeExecute( Sender : TObject ) ;
begin
    TMedaShape( SelectedObject ).Rotate ;
    Update ;
    UnselectObject ;
end ;

procedure TdmProject.actRotateShapeUpdate( Sender : TObject ) ;
begin
    ( Sender as TAction ).Enabled :=
        ( SelectedObject <> nil ) and ( SelectedObject is TMedaShape ) and
        ( SelectedObject.IsPlaced ) ;
end ;

procedure TdmProject.actMirrorShapeExecute( Sender : TObject ) ;
begin
    TMedaShape( SelectedObject ).Mirrorize ;
    Update ;
    UnselectObject ;
end ;

procedure TdmProject.actMirrorShapeUpdate( Sender : TObject ) ;
begin
    ( Sender as TAction ).Enabled :=
        ( SelectedObject <> nil ) and ( SelectedObject is TMedaShape ) and
        ( SelectedObject.IsPlaced ) ;
end ;

procedure TdmProject.actUnPlaceBankExecute( Sender : TObject ) ;
begin
    ( SelectedObject as TMedaBank ).Unplace ;
    Update ;
    UnselectObject ;
end ;

procedure TdmProject.actUnPlaceBankUpdate( Sender : TObject ) ;
begin
    ( Sender as TAction ).Enabled := ( SelectedObject <> nil ) and
        ( SelectedObject is TMedaBank ) and SelectedObject.IsPlaced ;
end ;

procedure TdmProject.actDeleteLineExecute( Sender : TObject ) ;
begin
    ( SelectedObject as TMedaLine ).Unplace ;
    ( SelectedObject as TMedaLine ).Vaporize ;
    Update ;
    UnselectObject ;
end ;

procedure TdmProject.actDeleteLineUpdate( Sender : TObject ) ;
begin
    ( Sender as TAction ).Enabled := ( SelectedObject <> nil ) and
        ( SelectedObject is TMedaLine ) and SelectedObject.IsPlaced ;
end ;

procedure TdmProject.actPlaceShapeExecute( Sender : TObject ) ;
var
    iTrans          : TMedaTransform ;
begin
    iTrans.Position := MakePoint( 500.0, 1000.0 ) ;
    iTrans.Rotation := drEast ;
    iTrans.Mirror := False ;
    if ( SelectedObject <> nil ) and
        ( SelectedObject is TMedaShape ) then begin
        ( SelectedObject as TMedaShape ).Place( vsbPCBViewer.DropLayerIndex, iTrans ) ;
        Update ;
    end ;
    UnselectObject ;
end ;

procedure TdmProject.actPlaceShapeUpdate( Sender : TObject ) ;
begin
    ( Sender as TAction ).Enabled := ( SelectedObject <> nil ) and
        ( SelectedObject is TMedaShape ) and ( not SelectedObject.IsPlaced ) ;
end ;

procedure TdmProject.actUnplaceShapeExecute( Sender : TObject ) ;
begin
    ( SelectedObject as TMedaShape ).Unplace ;
    Update ;
    UnselectObject ;
end ;

procedure TdmProject.actUnplaceShapeUpdate( Sender : TObject ) ;
begin
    ( Sender as TAction ).Enabled := ( SelectedObject <> nil ) and
        ( SelectedObject is TMedaShape ) and SelectedObject.IsPlaced ;
end ;

procedure TdmProject.actSaveShapeExecute( Sender : TObject ) ;
begin
    with LibrarySaveDialog do begin
        InitialDir := GetLibPath + 'Footprints\' ;
        Filter := 'MTX Footprint files (*.xml)|*.xml|All files (*.*)|*.*' ;
        DefaultExt := 'xml' ;
        Title := 'Save Footprint ' + SelectedObject.Designator + ' As' ;
        Filename := SelectedObject.Name + '.xml' ;
        if Execute then
            ( fXML as TfrmXML ).SaveToFile( SelectedObject, Filename ) ;
        UnselectObject ;
    end ;
end ;

procedure TdmProject.actSaveShapeUpdate( Sender : TObject ) ;
begin
    ( Sender as TAction ).Enabled := ( SelectedObject <> nil ) and
        ( SelectedObject is TMedaShape ) ;
end ;

procedure TdmProject.actDelShapeExecute( Sender : TObject ) ;
begin
    if MessageDlg( Format( 'Really delete footprint: "%s"?', [ SelectedObject.Name ] ), mtConfirmation, mbOKCancel, 0 ) = mrOK then begin
        SelectedObject.UnPlace ;
        SelectedObject.Vaporize ;
        Update ;
    end ;
    UnselectObject ;
end ;

procedure TdmProject.actDelShapeUpdate( Sender : TObject ) ;
begin
    ( Sender as TAction ).Enabled := ( SelectedObject <> nil ) and
        ( SelectedObject is TMedaShape ) ;
end ;

procedure TdmProject.actDelBankExecute( Sender : TObject ) ;
begin
    if MessageDlg( Format( 'Really delete bank: "%s"?', [ SelectedObject.Name ] ), mtConfirmation, mbOKCancel, 0 ) = mrOK then begin
        SelectedObject.UnPlace ;
        SelectedObject.Vaporize ;
        Update ;
    end ;
    UnselectObject ;
end ;

procedure TdmProject.actDelBankUpdate( Sender : TObject ) ;
begin
    ( Sender as TAction ).Enabled := ( SelectedObject <> nil ) and
        ( SelectedObject is TMedaBank ) ;
end ;

procedure TdmProject.actDeleteNetExecute( Sender : TObject ) ;
begin
    if MessageDlg( Format( 'Really delete net: "%s"?', [ SelectedObject.Name ] ), mtConfirmation, mbOKCancel, 0 ) = mrOK then begin
        SelectedObject.UnPlace ;
        SelectedObject.Vaporize ;
        Update ;
    end ;
    UnselectObject ;
end ;

procedure TdmProject.actDeleteNetUpdate( Sender : TObject ) ;
begin
    ( Sender as TAction ).Enabled := ( SelectedObject <> nil ) and
        ( SelectedObject is TMedaNet ) ;
end ;

procedure TdmProject.actDeletePortExecute( Sender : TObject ) ;
begin
    if MessageDlg( Format( 'Really delete port: "%s"?', [ SelectedObject.Name ] ), mtConfirmation, mbOKCancel, 0 ) = mrOK then begin
        SelectedObject.UnPlace ;
        SelectedObject.Vaporize ;
        Update ;
    end ;
    UnselectObject ;
end ;

procedure TdmProject.actDeletePortUpdate( Sender : TObject ) ;
begin
    ( Sender as TAction ).Enabled := ( SelectedObject <> nil ) and
        ( SelectedObject is TMedaNet ) ;
end ;

procedure TdmProject.actAddPortExecute( Sender : TObject ) ;
begin
    with TdlgAddPort.Create( Self ) do try
        if ShowModal = mrOK then begin
            ( SelectedObject as TMedaPart ).AddPort ;
            Update ;
        end ;
    finally
        Free ;
    end ;
    UnselectObject ;
end ;

procedure TdmProject.actAddPortUpdate( Sender : TObject ) ;
begin
    ( Sender as TAction ).Enabled := ( SelectedObject <> nil ) and
        ( SelectedObject is TMedaPart ) ;
end ;

procedure TdmProject.DataModuleCreate( Sender : TObject ) ;
begin
    fProject := TMedaProject.Create ;
    fProject.PCB := vsbPCBViewer ;
    fProject.Schematic := vsbSchematicViewer ;

    OpenDialog.InitialDir := GetWorkPath ;
    OpenDialog.Filter := 'MTX project files (*.mtx)|*.mtx|All files (*.*)|*.*' ;
    OpenDialog.DefaultExt := 'mtx' ;

    SaveDialog.InitialDir := GetWorkPath ;
    SaveDialog.Filter := 'MTX project files (*.mtx)|*.mtx|All files (*.*)|*.*' ;
    SaveDialog.DefaultExt := 'mtx' ;

    PEOpenDialog.InitialDir := GetWorkPath ;
    PEOpenDialog.Filter := 'Performance EDA schematic files (*.prj, *.brd, *.sch)|*.prj;*.brd;*.sch|All files (*.*)|*.*' ;
    PEOpenDialog.DefaultExt := 'sch' ;

    XilinxOpenDialog.InitialDir := GetWorkPath ;
    XilinxOpenDialog.Filter := 'Xilinx CSV files (*.csv)|*.csv|All files (*.*)|*.*' ;
    XilinxOpenDialog.DefaultExt := 'csv' ;

    Tool := toolSelect ;
end ;

procedure TdmProject.DataModuleDestroy( Sender : TObject ) ;
begin
    fProject.Free ;
end ;

procedure TdmProject.Test ;
var
    Module          : TMedaModule ;
    Part            : TMedaPart ;
    Bank            : TMedaBank ;
    Page            : TMedaSchematicPage ;
    Shape           : TMedaShape ;
    iTrans          : TMedaTransform ;
begin
    iTrans.Rotation := drEast ;
    iTrans.Mirror := False ;
    Project.Filename := GetWorkPath + 'test.mtx' ;
    Project.Name := 'Test' ;

    Module := Project.NewModule ;
    Module.Name := 'Test1' ;
    Part := Module.AddPart ;
    Part.Name := 'MSP430' ;

    Page := vsbSchematicViewer.AddPage( 'a4', True ) ;

    Bank := ( fXML as TfrmXML ).ImportECPinPakBank( Part, GetLibPath + 'ECPinPak\MSP430.xml' ) ;
    iTrans.Position := MakePoint( 240.0, 400.0 ) ;
    Part.Place( Page, 'PM01', iTrans, Bank ) ;

    Shape := ( fXML as TfrmXML ).ImportShape( Part, GetLibPath + 'Shapes\SQFP50P700X900-32N.xml' ) ;
    iTrans.Position := MakePoint( 500.0, 1000.0 ) ;
    Shape.Place( vsbPCBViewer.DropLayerIndex, iTrans ) ;

    Part.UpdatePorts ;

    Update ;
end ;

procedure TdmProject.actTestExecute( Sender : TObject ) ;
begin
    Test ;
    vsbSchematicViewer.CurrentPageIndex := 0 ;
end ;

procedure TdmProject.actSortExecute( Sender : TObject ) ;
begin
    Project.Sort ;
    Update ;
end ;

procedure TdmProject.actXilinxCSVExecute( Sender : TObject ) ;
begin
    with XilinxOpenDialog do begin
        if Execute then
            ConvertXilinxCSV( 'Convert', Filename, Filename + '.xml' ) ;
    end ;
end ;

procedure TdmProject.actSelectToolExecute( Sender : TObject ) ;
begin
    Tool := toolSelect ;
end ;

procedure TdmProject.actDrawToolExecute( Sender : TObject ) ;
begin
    Tool := toolDraw ;
end ;

procedure TdmProject.actDragToolExecute( Sender : TObject ) ;
begin
    Tool := toolDrag ;
end ;

procedure TdmProject.actConnectToolExecute( Sender : TObject ) ;
begin
    Tool := toolConnect ;
end ;

procedure TdmProject.SetTool( const Value : TMedaTool ) ;
begin
    fTool := Value ;
end ;

procedure TdmProject.actSelectToolUpdate( Sender : TObject ) ;
begin
    ( Sender as TAction ).Checked := Tool = toolSelect ;
end ;

procedure TdmProject.actDrawToolUpdate( Sender : TObject ) ;
begin
    ( Sender as TAction ).Checked := Tool = toolDraw ;
end ;

procedure TdmProject.actDragToolUpdate( Sender : TObject ) ;
begin
    ( Sender as TAction ).Checked := Tool = toolDrag ;
end ;

procedure TdmProject.actConnectToolUpdate( Sender : TObject ) ;
begin
    ( Sender as TAction ).Checked := Tool = toolConnect ;
end ;

function TdmProject.CreateMouseHandler( aMouseFactory : TMouseFactory ; Shift : TShiftState ; aGrid : integer ) : TMouseHandler ;
begin
    Result := nil ;
    if ssLeft in Shift then begin
        if ( ssCtrl in Shift ) and ( ssShift in Shift ) then
            Result := aMouseFactory.CreateLinker( aGrid )
        else
            case Tool of
                toolSelect : Result := aMouseFactory.CreateSelector( aGrid ) ;
                toolDraw : Result := aMouseFactory.CreateDrawer( aGrid ) ;
                toolDrag : Result := aMouseFactory.CreateDragger( aGrid ) ;
                toolConnect : Result := aMouseFactory.CreateConnector( aGrid ) ;
            end ;
    end
    else if ssRight in Shift then
        Result := aMouseFactory.CreateRight( aGrid ) ;
end ;

procedure TdmProject.RegisterTree( aTreeForm : TFrame ) ;
begin
    fProjTree := aTreeForm ;
end ;

function TdmProject.SelectedObject : TMedaObject ;
begin
    Result := nil ;
    if assigned( fProjTree ) then
        Result := ( fProjTree as TfrmProjTree ).SelectedObject ;
end ;

procedure TdmProject.UnselectObject ;
begin
    if assigned( fProjTree ) then
        ( fProjTree as TfrmProjTree ).UnselectObject ;
end ;

function TdmProject.GetPopup( aObject : TMedaObject ) : TPopupMenu ;
begin
    Result := nil ;
    if assigned( fProjTree ) then
        Result := ( fProjTree as TfrmProjTree ).GetPopup( aObject ) ;
end ;

initialization
    ForceCurrentDirectory := True ;

end.

